perm filename DESTRU.3[AID,LSP]  blob 
sn#420607 filedate 1979-02-22 generic text, type C, neo UTF8
 
COMMENT ā   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	(defun destructure (l)
C00004 ENDMK
Cā;
;(defun destructure (l)
;       (destructure1 l nil))
(defun %%destructure1%% (l path)
       (cond ((null l) nil)
	     ((atom l)(ncons (cons l path)))
	     (t (append (%%destructure1%% (car l) (cons 'car path))
			(%%destructure1%% (cdr l) (cons 'cdr path))))))  
(defun %%destructurify%% (vars vals)
 (mapcar
  (function
   (lambda (q r)
	   (cond ((atom q)
		   (list q r nil))
		 ((atom r)
		  (list nil nil (%%pathify%% (%%destructure1%% q nil) r)))
		 (t ((lambda (g)
		      (list g r (%%pathify%% (%%destructure1%% q nil) g)))  
		     (gensym))))))
  vars vals))
(defun %%pathify%% (path gen)
       (mapcar
	(function 
	 (lambda (q)
	  (list (car q) (%%code-path%% (cdr q) gen))))  
	 path))
(defun %%code-path%% (path name)
 (cond ((null path) name)
       (t (list (car path) (%%code-path%% (cdr path) name)))))